00100	C**** ITMSUB, BMS, METER, RNOTE, MAKNUM, IABS, DRWNT, RHORZ, RDRAW
00200	C  ********** WHOLE & HALF RESTS, BEAMS ******
00300		SUBROUTINE ITMSUB
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00600		COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00800		COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00900		COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
01000		1 RJA,YY,DISX,HGT,RZ,INP(53)
01100		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01200		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01300		1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
01400		1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
01500		DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01600		1,RDBR/ 7.0/,RBR/.33/,RBX/ 7.0/
01700	C  RDBR IS SPACER FOR DBL BAR.
01800	C  RTF COMPENSATES FOR BAD PLANNING.
01900		RST7=RSTJ2*7.
02000		RST18=RSTJ2*18.
02100	C  TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02200	
02300		R3Q=R3
02400	CC???	JY=0
02500		IF(JA.EQ.6)GO TO 90
02600		IF(JA.EQ.8)GO TO 100
02700	C  GO TO LINES, BEAMS, STAVES.
02800	C   NEXT DRAWS STRAIGHT LINES
02900	
03000		RD=R4*RST7
03100		RA=0
03200		RX=RTF*RSTJ2+POS
03300	C  SOMEDAY ADD < RDIS=1./DIS >  TO REPLACE ALL 1./DIS'S
03400		IF(J5.EQ.50)GO TO 300
03500	C  50 IS FOR CRESC., DECRESC. AND BOXES
03600		IF(R6.NE.0)GO TO 401
03700		IF(J7.NE.0)GO TO 401
03800	C  FOR BAR LINES
03900	4000	JA=44
04000	C  CODE # IS CHNGD SO BAR LINES WON'T AFFECT MAX. HGT.
04100	C ↑↑↑↑↑↑↑↑↑ FOR VERTICAL WIGGLE (P6=0, P7=-1)
04200		DBR=0 
04300		IF(J4.LT.1000)GO TO 400
04400	C  J4=1001 = DBL BAR,  =1401 = DBL BAR WITH RT. ONE HEAVY: J5=1=DOTS ADDED
04500	CK	J4=J4-1000
04600	CK	DBR=-1
04700	CK400	J7=(J4/100)*DIS
04800		DBR=J4/1000
04810		J4=J4-DBR*1000
04820	C DBR=1 HEAVY BAR IS ON RT.  =2 ON LEFT.
04840		IF(J5.EQ.0)GO TO 400
04850	C  NEXT ADDS REPEAT DOTS TO DBL BAR.
04860		L=J4
04870		J4=0
04880	C  MUST BE 0 FOR DOTS IN 'NOTWRT'
04890		JA=9
04900		J5=7
04910		RST7=8.+AMOD(R4,100.0)
04920		IF(DBR.EQ.1)RST7=-RST7-14.
04925		RA=R3
04930		R3=RA+RST7*RSTJ2
04940		DO 3400 K=J2,MOD(L,100)+J2-1
04950		POS=STFF(K)
05000		R4=6
05020		CALL CENTX
05040	C  SPACES DOTS OUT FROM BAR
05060		CALL NOTWRT
05080	C  GO GET THE DOT
05100		R4=8
05120		CALL CENTX
05140	3400	CALL NOTWRT
05160	C  DO I NEED ANY MORE RESETS????
05200		J4=L
05510	400	K=J4/100
05520	C  K IS FOR SPACING OF THIN BAR IN HEAVY-THIN ORDER
05530		J7=K*DIS
05540	C  J7=NUM OF STROKES -- BASED ON FINAL SIZE FACTOR (DIS)
05550		L=MOD(J4,100)
05600		IF(L.EQ.0)L=1
05700		L=L+J2-1
05800	C J4=401 MAKES 4X THICK BARLINE - ONE STAFF
05900		RA=RTF
06000		IF(L.LE.4)GO TO 2400
06100		L=4
06200		RA=300.
06300	C FOR EXTENDING BARS ABOVE STAFF 4
06400	2400	RY=RSTFAC(L)
06500		RY=STFF(L)+(RA+56.)*RY
06600	1400	RA=1
06700		IF(PLT.GE.0)GO TO 140
06800		J7=J7+1
06900		RA=1./DIS
07000	C  BAR LINES PLOT AS DOUBLE THICKNESS
07100	140	RJX=R3Q
07200	42	CALL LINES(R3Q,RX,3)
07300		RJ=-1.
07400		RW=RY
07500	406	CALL LINES(RJX,RY,2)
07600		IF(J10.EQ.0)GO TO 411
07700	C  P10 WILL THICKEN VERTICAL (OR MOSTLY VERTICAL) LINES.
07800		J7=J10*DIS
07900		J10=0
08000		RA=1./DIS
08100	411	IF(J7.GT.0)GO TO 409
08200		IF(DBR.EQ.0)RETURN
08300		RY=RW
08400	CK	R3Q=R3Q-RDBR
08500		RA=RJX+RDBR
08600		IF(DBR.EQ.1)RA=R3Q-RDBR
08700		DBR=0
08800		R3Q=RA
08900		GO TO 1400
09000	CC411	IF(J7.LE.0)RETURN
09100	C  FOR 'HEAVY' LINE.
09200	409	RJX=RJX+RA
09300		CALL LINES(RJX,RY,2)
09400		J7=J7-1
09500		RY=RW
09600		IF(RJ)RY=RX
09700		RJ=-RJ
09800		GO TO 406
09900	CC43	IF(RA.LE.0)RETURN
10000	C   HOW IS RA.NE.0?
10100	C  DRAWS BAR LINES. J4>0 CAUSES FULL LINE.
10200	CC403	RA=RA-3.72
10300	CC	R3Q=R3Q+22
10400	CC	RJX=RJX+22
10500	C   DO ABOVE NEED *RSTJ2? ************
10600	C **** BASED ON '596' ****
10700	CC	GO TO 42
10800	
10900	C  FOR CRESC., DECRESC.
11000	300	IF(R7.EQ.0)R7=2.3
11100		IF(R7.EQ.-1.)R7=-2.3
11200		RA=ABS(R7/2.0)*RST7
11300	C   AMOUNT OF SPREAD
11400		RJ=R3Q
11500		RX=RX-RST18+RD
11600		IF(R8.NE.0)GO TO 302
11700	C  JUMP TO MAKE BOX
11800		R6=RHORZ(R6)
11900		IF(R7)GO TO 301
12000		RJ=R6
12100		R6=R3Q
12200	301	CALL LINX(RJ,RX+RA,R6,RX)
12300		CALL LINES(RJ,RX-RA,2)
12400	C FOR CRESC, DECRESC:4 POS1, STF, HGT, 50, POS1, +OR-N(0=2.3,-1=-2.3)
12500	CC	IF(PLT.NE.-2)RETURN
12600		IF(PLT.GE.0)RETURN
12700	C  THIS MAKES ALL CRESC. DBL THICKNESS AT PRINT TIME.
12800		IF(J8)RETURN
12900		RX=RX+1./DIS
13000		J8=-1
13100	C FOR DOUBLE THICKNESS
13200		GO TO 301
13300	
13400	302	R8=R8*RST7
13500		R9=R9*RST7
13600		IF(R9.EQ.0)R9=R8
13700	C  R9=0 MAKES SQUARE    
13800		R3=R3Q-R8/2.
13900		RX=RX-R9/2.
14000		J10=J10*DIS
14100	C  DRAWS BOX, CENTER IS IN MIDDLE 
14200	C  4,POS,STF,NT#,50,0,0,,SIZ1[BY NT#S],SIZ2
14300	1302	CALL LINX(R3,RX,R3+R8,RX)
14400		CALL LINES(R3+R8,RX+R9,2)
14500		CALL LINES(R3,RX+R9,2)
14600		CALL LINES(R3,RX,2)
14700		IF(J10.EQ.0)RETURN
14800		J10=J10-1
14900		RJ=1./DIS
15000		R3=R3-RJ
15100		R8=R8+RJ+RJ
15200		RX=RX-RJ
15300		R9=R9+RJ+RJ
15400		GO TO 1302
15500	C  TO THICKEN BOXES.
15600	
15700	1401	R4=2.0
15800	C FOR HEAVY BRACK.
15900		RA=RSTJ2*RBX
16000		RX=RX-RA
16100	C  THE BOTTOM
16200		L=J4+J2-1
16300		R6=RTF
16400		IF(L.LE.4)GO TO 4401
16500		L=4
16600		R6=300.
16700	4401	RA=STFF(L)
16800	C SAVE FOR POS. OF BRACK. END ON UPPER STAFF.
16900		RJY=RSTFAC(L)
17000		RY=RA+R6*RJY+RJY*56.+RJY*RBX
17100	C  THE TOP
17200		R5=9.5
17300		GO TO 2401
17400	
17500	C  DASHES
17600	401	POS=POS-RST18
17700	C********* 27/9/72 ******
17800		IF(J7.LE.0)GO TO 407
17900		IF(J7.EQ.4)GO TO 1401
18000		IF(J7.NE.3)GO TO 4001
18100	C  NEXT IS FOR VARIABLE LARGE BRACKET. P7=3 P10=THICK. P5=HGT P6=P3
18200	2401	JA=3
18300		IF(J10.EQ.0)J10=5
18400	C  DEFAULT VALUE FOR THICKNESS =5
18500		R4=R4-RBR
18600		J9=0
18700		J5=35
18800	C  THE NUM FOR THE LITTLE END ITEMS
18900	CC	RY=R6-2.1*RSTJ2
19000		R6=3 
19100		R7=0
19200	C DOES LOWER ONE FIRST.  ITEM IS IN 'CLEF3.DMD' ON DAT.LCS
19300		IF(J8.NE.2)CALL CLEFS
19400	C P8=1=BOTTOM 1/2 BRACK. ONLY:  =2=TOP 1/2 ONLY:  0=COMPLETE
19500		R4=R5-RBR
19600		R6=3
19700		R7=-3
19800	C  TURNS IT UPSIDE DOWN.
19900	CC	JA=3
20000		IF(J7.NE.4)GO TO 3401
20100		POS=RA
20200		R4=R4*RJY/RSTJ2
20300	C  TO ADJUST HEIGHT OF BRACK END WHEN STAVES ARE DIFF. SIZES.
20400	3401	IF(J8.NE.1)CALL CLEFS
20500		R3Q=R3Q-12.0*RSTJ2
20600		IF(J7.NE.4)GO TO 407
20700		J7=0
20800		GO TO 140
20810	
20820	4002	J5=4
20825	C FOR CURVY BRACKET.  P6 CAN CHANGE WIDTH.
20830		R8=0
20835		J4=J4+J2-1
20840		R7=(.3136*RSTFAC(J4)+.0056*(STFF(J4)-STFF(J2)))/RSTJ2
20850	C  .0056=.0392/7.(THE MAGIC NUM FOR VERT SIZE OF BRACK.) .3136=8*.0392
20860	C  ADD DIST BETWEEN BOTTOM OF STAVES TO HEIGHT OF TOP STAFF
20870		IF(R6.EQ.0)R6=1.+R7/20.
20880		JA=3
20885		R4=2.3
20887	C  C  BECAUSE BRACK DOESN'T REALLY GO UP FROM 0 ?!?X*⊗
20890		CALL CLEFS
20895		RETURN
20900	
20990	4001	IF(J7.EQ.5)GO TO 4002
21000		IF(R8.EQ.0)R8=.8
21100	C  P8 CAN SET SIZE OF DASH
21200		RD=RD+POS
21300		IF(J7.EQ.1)GO TO 402
21400	C  =1 =VERTICAL DASHES
21500		RA=RHORZ(R6)
21600		RST7=5.96*RSTJ2
21700		RJX=R3Q
21800		GO TO 420
21900	402	RA=POS+R5*RST7
22000		RJY=RD
22100	C  SAVE FOR THICK LINES
22200	420	RJ=R8*RST7
22300	41	L=3
22400		K=2
22500	416	CALL LINES(R3Q,RD,L)
22600		IF(J7.EQ.1)GO TO 412
22700	C  JUMP FOR VERTICAL DASH
22800		IF(R3Q.GE.RA)GO TO 413
22900	C  JUMP IF ALL DONE
23000		R3Q=R3Q+RJ
23100	414	CALL EXCH(L,K)
23200		GO TO 416
23300	412	IF(RD.GE.RA)GO TO 413
23400	C  JUMP IF DONE
23500		RD=RD+RJ
23600		GO TO 414
23700	413	IF(J10.LE.0)RETURN
23800	C  NEXT FOR THICK DASHES
23900		J10=J10-1
24000		IF(J7.EQ.1)GO TO 415
24100		R3Q=RJX
24200		RD=RD+1./DIS
24300		GO TO 41
24400	415	R3Q=R3Q+1./DIS
24500		RD=RJY
24600		GO TO 41
24700	
24800	
24900	407	RX=RD+POS
25000		RY=R5*RST7+POS
25100		IF(J7.EQ.3)GO TO 140
25200		CALL NOZERO(R9)
25300		IF(J7.EQ.-1)GO TO 408
25400	C  FOR 'TR' J7=-2, 'ARPEGG' J7=-1,  STRAIGHT LINES J7=0
25500	CC  WHY THE IFIX????	RJX=IFIX(RHORZ(R6))
25600		RJX=IFIX(ROFF(RHORZ(R6)))
25700	C  ALL THIS CRAP SO IT WILL MATCH UP WITH P3 WHEN NECESSARY.
25800		IF(J7.EQ.0)GO TO 42
25900		RY=R9*RST7+RX
26000		CALL NOZERO(R8)
26100	4041	RZ=RX
26200		RH=RY
26300	C  SAVE FOR THICK WIGGLES
26400		CALL LINES(R3Q,RX,3)
26500	C  DRAWS STRAIGHT LINES. ETC.
26600		R9=R3Q
26700		RJ=RY
26800		RW=3.*RSTJ2*R8
26900		RA=RW*2.5
27000	C  P8=HORZ. WIGGLE SIZE;  P9=VERT. SIZE
27100	404	R9=R9+RA
27200		CALL LINES(R9,RJ,2)
27300		R9=R9+RW
27400		CALL LINES(R9,RJ,2)
27500	405	CALL EXCH(RX,RJ)
27600		IF(R9.LT.RJX)GO TO 404
27700		IF(J10.LE.0)RETURN
27800		RX=RZ+1./DIS
27900		RY=RH+1./DIS
28000		J10=J10-1
28100		GO TO 4041
28200	C  P10= + NUM OF THICKNESSES TO WIGGLE
28300	
28400	408	IF(RX.GT.RY)CALL EXCH(RX,RY)
28500		RZ=R9*RSTJ2*5.96
28600	C  USE P9 TO SET WIGGLE WIDTH.  P8 TO SET HGT.
28700		CALL NOZERO(R8)
28800		RD=R8*RST7*.5
28900		RJ=RD
29000		IF(RD.LT.1.)RD=1.
29100	421	R9=RX
29200		RW=R3Q
29300		RA=RZ+R3Q
29400		CALL LINES(RW,R9,3)
29500	410	R9=R9+RJ
29600		CALL LINES(RA,R9,2)
29700		R9=R9+RD
29800		CALL LINES(RA,R9,2)
29900		CALL EXCH(RA,RW)
30000		IF(R9.LT.RY)GO TO 410
30100		IF(J10.LE.0)RETURN
30200		R3Q=R3Q+1./DIS
30300		J10=J10-1
30400		GO TO 421
30500	C  VERTICAL WIGGLE   P10=+ NUM OF THICKNESSES.
30600	
30700	
30800	C  NEXT IS FOR BEAMS
30900	90	RMINI=RSTJ2
31000		RX=2.7*RSTJ2*5.96
31100	C******************************
31200		R6=RHORZ(R6)
31300		IF(R8.NE.0)GO TO 204
31400		IF(R10.GE.10)GO TO 204
31500		IF(J7)GO TO 204
31600		IF(R9.NE.0)GO TO 1
31700	C  R8=0 AND R9=NUM  -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLETS, ETC.)
31800	204	IF(R9.NE.0)R9=RHORZ(R9)
31900		IF(J7)GO TO 201
32000	200	IF(J10.LT.10)GO TO 91
32100	C NEXT FOR INNER, PARTIAL BEAMS
32200		R8=RHORZ(R8)
32300		R10=AMOD(R10,10.)
32400		GO TO(2,3,4),J10/10
32500	2	RH=R9+RX
32600		GO TO 1
32700	3	R8=R9-RX
32800	C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
32900	4	RH=R8
33000	C  LEFT INNER POS.
33100		GO TO 1
33200	201	J7=-J7
33300	C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=DISP.
33400		CALL NOZERO(R10)
33500	C  ALWAYS AT LEAST 1 IN DISPLACEMENT
33600		J10=30
33700	C TO ACTIVATE PARTIAL BEAM SECTION
33800		IF(J9.NE.0)GO TO 202
33900	C  NEXT FOR TREM. WITHOUT OTHER BEAMS.
34000		RH=-1
34100		IF(J7.GE.20)RH=-RH
34200	CC203	R4=R4+R10*RH
34300	CC	CALL CENTX
34400		R5=R4+RH
34500		R9=R3
34600		R6=R3+22.*RMINI
34700	202	IF(R8.EQ.0)R8=4. 
34800		RX=R8*RMINI*2.98
34900		RH=R9+RX
35000		R9=R9-RX
35100		GO TO 1
35200	
35300	91	IF(J8.EQ.0)GO TO 1
35400		IF(J8.GT.0)GO TO 92
35500	C FOR J8=-(10+DN) OR -(20+DN)
35600		R9=R3+RX
35700		IF(J8.LE.-20)R9=R6-RX
35800	192	J8=-J8
35900	92	IF(J10.EQ.0)J10=MOD(J8,10)
36000	CC??? 4/75	J8=J8-J10
36100		IF(J10.EQ.0)J10=1
36200		R10=J10
36300	C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
36400	1	IF(IABS(J4).LT.100)GO TO 97
36500		RMINI=.6*RSTJ2
36600		R5=AMOD(R5,100.0)
36700	C   SPACE BETWEEN BEAMS
36800	97	RJ=RMINI*11.
36900		RW=RMINI*RHGT
37000	C  DIST. UP OR DOWN FROM NOTE HEAD.
37100		RJA=R10*RJ
37200	C  DISPLACEMENT
37300		RD=R9
37400	C  POSITION 3
37500		RJX=CENTR-RW+RJA
37600	C  FINAL HEIGHT OF LEFT SIDE
37700	C  NEG R7=TREMOLO
37800		RX=MOD(J7,10)
37900		JJ2=J7-20
38000		RA=R6
38100	C  HORIZANTAL DIST.
38200		RJY=R5*RST7+POS-RST18-RW+RJA
38300	C   VERTICAL POS OF RIGHT SIDE.
38400		RW=R14*RMINI
38500		RY=1.
38600		IF(J7.GE.20)GO TO 98 
38700	C JUMP IF STEMS ARE DOWN
38800		RY=-RY
38900	C  FOR  THICKENING INCR.
39000		JJ2=J7-10
39100		RJ=-RJ
39200		RJA=RMINI*R2HGT-2.*RJA
39300		RJX=RJX+RJA
39400		RJY=RJY+RJA
39500		R3Q=R3Q+RW
39600	C  POSITION 1
39700		RA=RA+RW
39800	C  POSITION 2
39900		RD=RD+RW
40000	C******************************
40100		RH=RH+RW
40200	98	RSTJ2=RSTJ2*RBM
40300	C  RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
40400	93	IF(JJ2.GT.RX)GO TO 94
40500		IF(J10.GE.10)GO TO 7
40600	C**********************
40700		IF(J8.EQ.0)GO TO 94
40800		R3=RW
40900		IF(J9.EQ.0)GO TO 292
41000	 	IF(J8.GE.20)GO TO 193
41100	293	RX=R3Q-RD
41200		GO TO 194
41300	7	RHX=RH-R3Q
41400		R3=RD-R3Q
41500		GO TO 292
41600	193	RX=RD-RA
41700	194	R3=ABS(RX)
41800	292	DISX=ABS(R3Q-RA)
41900		HGT=RJX-RJY
42000		IF(J10.GE.10)HGT1=HGT*RHX/DISX
42100	C**********************
42200		R3=R3/DISX
42300	195	HGT=HGT*R3
42400	196	L=J8/10
42500		J8=0
42600		IF(J10.GE.10)GO TO 8
42700	C***************
42800		IF(L.EQ.1)GO TO 95
42900	C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
43000		R3Q=RD
43100		RJX=RJY+HGT
43200		GO TO 94
43300	C**************
43400	8	R3Q=RH
43500		RA=RD
43600		RJY=RJX-HGT
43700		RJX=RJX-HGT1
43800		GO TO 94
43900	95	RA=RD
44000		RJY=RJX-HGT
44100	94	L=7.*RMINI
44200	930	RC=0
44300	C  MINI LINES HAVE .2 SMALLER BEAMS.  MAYBE CHANGE THIS??
44400		CALL LINES(R3Q,RJX,3)
44500		DO 941 K=1,L
44600		CALL BMS
44700		IF(PLT.GE.0)GO TO 940
44800		RC=RC+RY
44900	C FOR THICKENING.
45000		CALL BMS
45100		CALL EXCH(RA,R3Q)
45200	941	CALL EXCH(RJY,RJX)
45300		CALL BMS
45400	C  DRAWS 5 LINES FOR BEAMS.
45500	940	JJ2=JJ2-1
45600		IF(JJ2.LE.0)GO TO 942
45700	C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
45800		RJY=RJY+RJ
45900		RJX=RJX+RJ
46000		GO TO 930
46100	
46200	942	IF(R8.NE.0)RETURN
46300		IF(R9.EQ.0)RETURN
46400		IF(R10.GE.30)RETURN
46500	C FOR NUMBERS OUTSIDE BEAMS
46600		RSTJ2=RMINI
46700		RD=-10.
46800		IF(R7.LT.20)RD=8.3
46900	943	J3=R3Q+(RA-R3Q)/2.
47000		R6=1.
47100	CC *** DONE IN CENTX ***	R4=AMOD(R4,100.)
47200		R4=R4+(R5-R4)/2.+RD
47300		R7=1
47400	C ITALICS
47500		CALL MAKNUM(R9)
47600		RETURN
47700	
47800	100	RA=0
47900	C  FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S), 
48000	C  P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
48100	C  P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS. 
48200	C  PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
48300		IF(R5.EQ.0)R5=RSTFAC(J2)
48400		CALL NOZERO(R5)
48500		RSTFAC(J2)=R5
48600		RX=(J2+3)*123-369.+R4*7.*R5
48700	CC	RC=R5
48800		STFF(J2)=RX
48900		RX=RX+RTF*R5
49000	C  FOR RTF SEE DATA
49100		RA=RX
49200	C  FOR 2 PASS PLOTTING
49300		RJ=RHORZ(R6)
49400		IF(R6.EQ.0)RJ=596
49500		R5=R5*14.
49600		IF(R8.EQ.0)GO TO 68
49700		IF(PLT)GO TO 68
49800		RZ=RX+R8*167.
49900	C  167 IS A MAGIC NUMBER!!  PUTS LINE ON DPY.
50000		CALL LINX(R3,RZ,RJ,RZ)
50100	C  SHOWS WHERE NEXT STAFF 0 WILL BE.
50200	68	IF(J7.EQ.0)GO TO 101
50300		IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
50400	C  TO ACTIVATE DPY BUFFER
50500		RETURN
50600	101	DO 6 K=1,5
50700		RZ=RJ
50800		RW=R3
50900		IF(K.EQ.2)GO TO 66
51000		IF(K.NE.4)GO TO 67
51100	66	CALL EXCH(RW,RZ)
51200	67	CALL LINX(RZ,RX,RW,RX)
51300	6	RX=RX+R5
51400		IF(RA.EQ.1000)RETURN
51500		IF(PLT.NE.-2)RETURN
51600		RX=RA-1./RHT
51700	CC	R5=RC
51800		RA=1000
51900		GO TO 101
52000		END
52100	
52200	CC	SUBROUTINE BMS
52300	CC	COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RJY
52400	CC	CALL LINES(RA,RJY+RC*RSTJ2,2)
52500	CC	END
52600	
52700		SUBROUTINE METER
52800	      COMMON R2,JA,CENTR,J2,RJQ(20),J3,JQ(19)/STF/RSTFAC(-3/4),RSTJ2
52900		COMMON/POSI/STFF(-3/4),JJ2,POS
53000		EQUIVALENCE (R4,RJQ(2)),(R7,RJQ(5)),(R6,RJQ(4)),(R5,RJQ(3))
53100		1,(R8,RJQ(6)),(RX3,RJQ(20)),(J10,JQ(7)),(J7,JQ(5)),(R9,RJQ(7))
53200	
53300	C  PARAMS  18 / STF / POS / VERT HGT./ TOP NUM/ BOT NUM/ SIZE FAC.
53400	
53500		CALL NOZERO(R7)
53600		JZ=J3
53700		RY=R4+8.*R7
53800	C  HEIGHT
53900		RW=R6
54000	C  BOTTOM NUM
54100	C  P5=TOP NUM
54200		R6=R7
54300		RR6=R6
54400	C  SIZE
54500	C  FOR BDR40  -- OR =1
54600		M=0
54700		R4=RY
54800	2	R7=0
54900	C  R7=0 FOR BDR FONT??
55000	CC	IF(R5.NE.99)GO TO 1
55100		IF(R5.LT.90)GO TO 3
55200	C  99 AS METER = 'C'  98=ALLA BREVE (CUT TIME)
55300		M=-1
55400		IF(R5.NE.98)GO TO 4
55500	C NEXT FOR LINE THROUGH C.
55600		RZ=R6
55700		RY=R4
55800		RA=POS
55900		R6=RX3
56000	C  TO LINE UP WITH R3
56100		J10=2
56200	C  FOR THICK LINE
56300		R4=4.2
56400		R5=9.8
56500		J7=0
56600		R8=0
56700		CALL ITMSUB
56800		POS=RA
56900		R4=RY
57000		R6=RZ
57100	C GET BACK THE RIGHT PARAMS.
57200	
57300	4	R5=9999.
57400		GO TO 3
57500	C  TO CENTER 12S AND 16S
57600	3	CALL MAKNUM(R5)
57700		IF(M)RETURN
57800	C  STICK AROUND FOR BOTTOM NUM
57900		M=-1
58000		R4=RY-4.*RR6
58100		R6=RR6
58200		R5=RW
58300	C  GET BOTTOM NUM
58400		J3=JZ
58500		R8=0
58600		GO TO 2
58700		END
58800	
58900	CF	SUBROUTINE RNOTE(X)
59000	CF	COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
59100	CF	X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
59200	CF	END
59300	
59400		SUBROUTINE MAKNUM(RNUM)
59500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSTFAC(-3/4),RSTJ2
59600		EQUIVALENCE (J3,JQ(1)),(R4,RJQ(2)),(R8,RJQ(6)),(R7,RJQ(5))
59700	     1,(R6,RJQ(4)),(R5,RJQ(3)),(R7,RJQ(5)),(JQ(15),B),(JQ(16),C)
59800		1 ,(J8,JQ(6)),(J10,JQ(8)),(R3,RJQ(1)),(J5,JQ(3)),(RJY,JQ(19))
59900		1 ,(J7,JQ(5)),(J6,JQ(4)),(R9,RJQ(7))
60000		DATA RS/10.0/,RBX/1.0/
60100		RB8=R8
60200		J3X=J3
60300	C P7=0=BDR40; =1=BDI40; =2=PRIM.
60400		CALL NOZERO(R6)
60500		R5=R6
60600	C  UPPER CASE - BDR40
60700		R6=48000000.0+(R7+50.)*10000.
60800		R7=99999999.0
60900	C  BLANKS
61000		R8=R7
61100		IF(RNUM.NE.9999.)GO TO 2
61200	C  NEXT FOR 'C'OMMON TIME
61300		RNUM=12.
61400	C  MAKES A 'C'
61500		R4=R4-2.2
61600	C  .2 FOR BAD POS. OF LETTERS
61700		GO TO 4
61800	
61900	2	ONE=0 
62000		RNUM=IFIX(RNUM)
62100	C  SO MISTAKES (i.e. 2.2) WON'T BREAK THE PROG.
62200		IF(RNUM.EQ.1.)ONE=3.
62300		IF(RNUM.GT.9.)GO TO 3
62400	C  JUMP FOR 2 OR 3 DIGIT NUMBER
62500	4	R6=R6+RNUM*100.+47.
62600	C  PUTS BLANK ON END (.47)
62700		GO TO 1
62800	
62900	3	RJY=10.
63000		IF(RNUM.GE.100.)RJY=100.
63100		B=IFIX(RNUM/RJY)
63200		C=AMOD(RNUM,RJY)
63300		IF(RNUM.LT.100)GO TO 7
63400		D=IFIX(C/10.)
63500		C=AMOD(C,10.)
63600		IF(C.EQ.1.)ONE=ONE+3.
63700		R7=C*1000000.+999999.0
63800		C=D
63900	7	R6=R6+B*100.+C
64000		IF(B.EQ.1.)ONE=ONE+3.
64100		IF(C.EQ.1.)ONE=ONE+3.
64200		B=R5
64300		IF(RNUM.GE.100.)B=B*2
64400		J3=J3-RS*RSTJ2*B
64500	C  FOR 2 DIGIT NUMBER
64600	CCC	IF(RNUM.GE.20.)GO TO 6
64700	CCC	IF(JA.EQ.18)GO TO 6
64800	CCC	RJY=5.6
64900	CCC	IF(RNUM.GT.11.)RJY=3.
65000	C  ADJUSTS FOR 11, ETC.
65100	CCC	J2=J2+RJY*R5*RSTJ2
65200	CC6	J3=J2
65300	1	J3=J3+ONE*R5*RSTJ2
65400	C CENTERS THE NUMBER '1'
65500		CALL ALPHA
65600		J3=J3X
65700		IF(RB8.EQ.0)RETURN
65800	C NEXT FOR CIRCLES AND BOXES AROUND NUMBERS.
65900		R3=J3-R5
66000		IF(J10.EQ.0)J10=1
66100	C  USE J10 FOR EVEN THICKER BOX AND CIRC.
66200		IF(RNUM.GT.9)R3=R3+R5*RBX
66300	C  TO SET CENTER
66400		IF(RB8.EQ.2)GO TO 5
66500		R4=R4+R5+.1+.05/R5
66600	C  END OF ABOVE IS FOR SMALL CIRCLES.
66700		B=4.5
66800		IF(RNUM.GE.100.)B=5.5
66900		R5=R5*B
67000		JA=12
67100		J6=0
67200		J7=0
67300		J8=J10
67400		CALL CENTX
67500		CALL SLUR
67600		RETURN
67700	
67800	5	JA=4
67900		B=6
68000		R9=0
68100		IF(RNUM.LT.100.)GO TO 8
68200		B=9.
68300		R9=R5*6.
68400	C  MAKES RECTANGLE IF ≥100
68500	8	R4=R4+R5*.7+.1
68600		R8=R5*B
68700		J5=50
68800		CALL ITMSUB
68900	C  RETURNS ORIG. HORIZ. POS.
69000		END
69100	C  MAKES ONLY 1 TO 3 DIGIT NUMS NOW.  EXPAND LATER.
69200	
69300	CC	FUNCTION IABS(N)
69400	C  BECAUSE IABS IN LIB40 HAS A BUG.
69500	CC	IABS=N
69600	CC	IF(N)IABS=-N
69700	CC	END
69800	
69900	CF	SUBROUTINE DRWNT(RMINI)
70000	CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
70100	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
70200	CF	EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
70300	CF	1 (JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
70400	CF	1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
70500	CF	RJX=CENTR
70600	CF	JH=0
70700	C  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
70800	CC	CENTR=CENTR-21.*RSTJ2
70900	CF	RA=R6
71000	CF	R6=.5*RMINI/RSTJ2
71100	CF	R7=R6
71200	CF	RJD=RJZ-3
71300	CCXX	IF(RSTJ2.NE.RMINI)RJD=RJZ+.43*(RJZ-3.)-.3
71400	C  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
71500	CF	JI=0
71600	CF	CALL CLEFS
71700	CF	JI=R9
71800	C  ↑↑↑↑↑↑ NEEDED??
71900	C  FIX THIS???? ↑↑↑↑↑
72000	C  FOR WHITE NOTES AND ACCIS ON PLOTTER.
72100	CF	CENTR=RJX
72200	CF	R6=RA
72300	CF	R7=JG
72400	CF	JE=RJE
72500	CF	END
72600	
72700	CC	FUNCTION RHORZ(R)
72800	CC	RHORZ=R*5.96-596.
72900	CC	END
73000	
73100	CF	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
73200	C   TO X,Y INTO ONE WORD
73300	CF	DIMENSION XY(1)
73400	CF	DO 2 K=I,IFIX(S)
73500	CF	L=2
73600	CF	Y=XY(K)
73700	CF	IF(Y.LT.1000.)GO TO 3
73800	CF	L=3
73900	CF	Y=Y-1000.
74000	C   >1000 = INVIS. LINE
74100	CF3	M=Y
74200	CF	Y=(Y-M)*1000.
74300	CF	IF(Y.GT.100.)Y=100-Y
74400	C   Y NUMBERS .GT.100 ARE NEG.
74500	CF	B=Y*X+CENTR
74600	CF	IF(M.GT.60)M=100-M
74700	CF	A=M*RMINI+R3
74800	CF2	CALL LINES(A,B,L)
74900	CF	END
75000		
75100	CC	FUNCTION EEXP(X,Y)
75200	CC	EEXP=X**Y
75300	CC	END